home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Precision Software Appli…tions Silver Collection 4
/
Precision Software Applications Silver Collection Volume 4 (1993).iso
/
new
/
cuaclip.arj
/
ERRORSYS.PRG
< prev
next >
Wrap
Text File
|
1993-06-01
|
8KB
|
259 lines
*COMMENTS***********************************************************************
/*
Copyright(C) Delcom-Deltranik International Software Engineering 1990-1993.
$owner: BILLW$
$version: 1.1$ $date: March 16, 1993$ $time: 01:57:38 PM$
*/
static id_string := "$id: ssvcid errorsys.prg 1.1 March 16, 1993 01:57:38 PM$";
// $nokeywords$
********************************************************************************
*PROTOTYPES**********************************************************************
// Prototype Table
// - PROCEDURE ErrorSys()
// - STATIC FUNCTION DefError( e )
// - STATIC FUNCTION ErrorMessage( e )
********************************************************************************
*PREPROCESSOR*******************************************************************
#INCLUDE "error.ch"
#INCLUDE "cuaclip.ch"
#INCLUDE "mouse.ch"
// put messages to STDERR
#COMMAND ? <list,...> => ?? CHR( 13 ) + CHR( 10 ) ; ?? <list>
#COMMAND ?? <list,...> => OUTERR( <list> )
// used below
#DEFINE NTRIM( n ) ( LTRIM( STR( n ) ) )
********************************************************************************
*GLOBAL PROCEDURES**************************************************************
//┌──────────────────────────────────────────────────────────────────────────┐
//│ Description: │
//│ Author: Bill Wilson │
//│ Date created: 01-13-93 │
//│ Time created: 12:14:17pm │
//│ Copyright: Delcom International Software Engineering Inc. │
//├──────────────────────────────────────────────────────────────────────────┤
//│ Procedure: ErrorSys() │
//│ │
//│ Arguments: │
//│ │
//│ See Also: │
//│ │
//└──────────────────────────────────────────────────────────────────────────┘
PROCEDURE ErrorSys()
MEMVAR PromptList
PUBLIC PromptList := {}
ErrorBlock( {|e| DefError( e ) } )
InitMouse()
SetMousePos( ( MAXROW() / 2 ), ( MAXCOL() / 2 ) )
RETURN
********************************************************************************
*STATIC FUNCTIONS***************************************************************
//┌──────────────────────────────────────────────────────────────────────────┐
//│ Description: │
//│ Author: Bill Wilson │
//│ Date created: 01-13-93 │
//│ Time created: 12:14:17pm │
//│ Copyright: Delcom International Software Engineering Inc. │
//├──────────────────────────────────────────────────────────────────────────┤
//│ Function: DefError() │
//│ │
//│ Arguments: │
//│ │
//│ Return Value: │
//│ See Also: │
//│ │
//└──────────────────────────────────────────────────────────────────────────┘
STATIC FUNCTION DefError( e )
LOCAL i, cMessage, aOptions, nChoice, nOldMouse
// by default, division by zero yields zero
IF ( e:genCode == EG_ZERODIV )
RETU ( 0 )
ENDIF
// for network open error, set NETERR() and subsystem default
IF ( e:genCode == EG_OPEN .AND. e:osCode == 32 .AND. e:canDefault )
NETERR( .t. )
RETU( .f. ) // NOTE
ENDIF
// for lock error during APPEND BLANK, set NETERR() and subsystem default
IF ( e:genCode == EG_APPENDLOCK .AND. e:canDefault )
NETERR( .t. )
RETU( .f. ) // NOTE
ENDIF
// build error message
cMessage := ErrorMessage( e )
altd()
// build options array
// aOptions := {"Break", "Quit"}
aOptions := { "Quit" }
IF ( e:canRetry )
AAdd( aOptions, "Retry" )
ENDIF
IF ( e:canDefault )
AADD( aOptions, "Default" )
ENDIF
FOR i := 1 TO 10
DISPEND()
NEXT
// put up alert box
nChoice := 0
nOldMouse := SetMouse()
ClearMouse()
DO WHILE ( nChoice == 0 )
IF ( EMPTY( e:osCode ) )
nChoice := ALERT( cMessage, aOptions )
ELSE
nChoice := ALERT( cMessage + ;
";(DOS Error " + NTRIM(e:osCode) + ")", ;
aOptions )
ENDIF
IF ( nChoice == NIL )
EXIT
ENDIF
ENDDO
InitMouse()
SetMouse( nOldMouse )
SetMousePos( MouseInRow(), MouseInCol() )
IF ( !EMPTY( nChoice ) )
// do as instructed
IF ( aOptions[ nChoice ] == "Break" )
BREAK( e )
ELSEIF ( aOptions[ nChoice ] == "Retry" )
RETU( .t. )
ELSEIF ( aOptions[ nChoice ] == "Default" )
RETU( .f. )
ENDIF
ENDIF
// display message and traceback
IF ( !Empty( e:osCode ) )
cMessage += " ( DOS Error " + NTRIM( e:osCode ) + ") "
ENDIF
? cMessage
i := 2
DO WHILE ( !EMPTY( ProcName( i ) ) )
? "Called from", TRIM( PROCNAME( i ) ) + ;
"(" + NTRIM( PROCLINE( i ) ) + ") "
i++
ENDDO
// give up
ErrorLevel( 1 )
QUIT
RETURN (.f.)
//┌──────────────────────────────────────────────────────────────────────────┐
//│ Description: │
//│ Author: Bill Wilson │
//│ Date created: 01-13-93 │
//│ Time created: 12:14:17pm │
//│ Copyright: Delcom International Software Engineering Inc. │
//├──────────────────────────────────────────────────────────────────────────┤
//│ Function: ErrorMessage() │
//│ │
//│ Arguments: │
//│ │
//│ Return Value: │
//│ See Also: │
//│ │
//└──────────────────────────────────────────────────────────────────────────┘
STATIC FUNCTION ErrorMessage( e )
LOCAL cMessage
// start error message
cMessage := IF( e:severity > ES_WARNING, "Error ", "Warning " )
// add subsystem name if available
IF ( VALTYPE( e:subsystem ) == "C" )
cMessage += e:subsystem()
ELSE
cMessage += "???"
ENDIF
// add subsystem's error code if available
IF ( VALTYPE( e:subCode ) == "N" )
cMessage += ("/" + NTRIM( e:subCode ) )
ELSE
cMessage += "/???"
ENDIF
// add error description if available
IF ( VALTYPE( e:description ) == "C" )
cMessage += ( " " + e:description )
ENDIF
// add either filename or operation
IF ( !EMPTY( e:filename ) )
cMessage += ( ": " + e:filename )
ELSEIF ( !EMPTY( e:operation ) )
cMessage += ( ": " + e:operation )
ENDIF
RETURN (cMessage)
********************************************************************************